home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 1 Issue 2 / PDCD-1 - Issue 02.iso / _utilities / utilities / 003 / _gs / !GS / ps / BDFTOPS < prev    next >
Text File  |  1991-10-25  |  24KB  |  745 lines
  1. %    Copyright (C) 1990, 1991 Aladdin Enterprises.  All rights reserved.
  2. %    Distributed by Free Software Foundation, Inc.
  3. %
  4. % This file is part of Ghostscript.
  5. %
  6. % Ghostscript is distributed in the hope that it will be useful, but
  7. % WITHOUT ANY WARRANTY.  No author or distributor accepts responsibility
  8. % to anyone for the consequences of using it or for whether it serves any
  9. % particular purpose or works at all, unless he says so in writing.  Refer
  10. % to the Ghostscript General Public License for full details.
  11. %
  12. % Everyone is granted permission to copy, modify and redistribute
  13. % Ghostscript, but only under the conditions described in the Ghostscript
  14. % General Public License.  A copy of this license is supposed to have been
  15. % given to you along with Ghostscript so you can know your rights and
  16. % responsibilities.  It should be in a file named COPYING.  Among other
  17. % things, the copyright notice and this notice must be preserved on all
  18. % copies.
  19.  
  20. % bdftops.ps
  21. % Convert a BDF file to a Ghostscript font.
  22.  
  23. % Ghostscript fonts are in the same format as Adobe Type 1 fonts,
  24. % except that they do not use eexec encryption.
  25. % See gfonts.ps for more information.
  26.  
  27. /envBDF 120 dict def
  28. envBDF begin
  29.  
  30. % Define whether to write out the CharStrings in binary or in hex.
  31. % Binary takes less space on the file, but isn't guaranteed portable.
  32.    /binary false def
  33.  
  34. % Define lenIV (the number of initial random bytes in the encoded outlines).
  35. % This should be zero, but we set it to 4 for compatibility with PostScript.
  36.    /lenIV 4 def
  37.  
  38. % Invert the StandardEncoding vector.
  39.    256 dict dup begin
  40.    0 1 255 { dup StandardEncoding exch get exch def } for
  41.    end /decoding exch def
  42.  
  43. % Define the dictionary equivalent of ].
  44.    /dicttomark
  45.     { counttomark 2 idiv dup dict begin
  46.        { def } repeat
  47.       pop currentdict end 
  48.     } bind def
  49.  
  50. % Define the character sequences used to fill in some undefined entries
  51. % in the standard encoding.
  52.    mark
  53.      (exclamdown) [/exclam]
  54.      (fraction) [/slash]
  55.      (florin) [/f]
  56.      (quotesingle) [/quoteright]
  57.      (quotedblleft) [/quotedbl]
  58.      (guillemotleft) [/less /less]
  59.      (guilsinglleft) [/less]
  60.      (guilsinglright) [/greater]
  61.      (fi) [/f /i]
  62.      (fl) [/f /l]
  63.      (endash) [/hyphen /hyphen]
  64.      (periodcentered) [/asterisk]
  65.      (bullet) [/asterisk]
  66.      (quotesinglbase) [/quotesingle]
  67.      (quotedblbase) [/quotedbl]
  68.      (quotedblright) [/quotedbl]
  69.      (guillemotright) [/greater /greater]
  70.      (ellipsis) [/period /period /period]
  71.      (questiondown) [/question]
  72.      (grave) [/quoteleft]
  73.      (acute) [/quoteright]
  74.      (circumflex) [/asciicircum]
  75.      (tilde) [/asciitilde]
  76.      (dieresis) [/quotedbl]
  77.      (cedilla) [/comma]
  78.      (hungarumlaut) [/quotedbl]
  79.      (emdash) [/hyphen /hyphen /hyphen]
  80.      (AE) [/A /E]
  81.      (OE) [/O /E]
  82.      (ae) [/a /e]
  83.      (dotlessi) [/i]
  84.      (oe) [/o /e]
  85.      (germandbls) [/s /s]
  86.    dicttomark /composites exch def
  87.  
  88. % Note the characters that must be defined as subroutines.
  89.    96 dict begin
  90.      0 composites
  91.       { exch pop
  92.          { dup currentdict exch known
  93.         { pop }
  94.         { 1 index def 1 add }
  95.        ifelse
  96.      }
  97.     forall
  98.       }
  99.      forall pop
  100.      currentdict
  101.    end /subrchars exch def
  102.  
  103. % Define the overstruck characters that can be synthesized with seac.
  104.    mark
  105.     [ /Aacute /Acircumflex /Adieresis /Agrave /Aring /Atilde
  106.       /Ccedilla
  107.       /Eacute /Ecircumflex /Edieresis /Egrave
  108.       /Iacute /Icircumflex /Idieresis /Igrave
  109.       /Ntilde
  110.       /Oacute /Ocircumflex /Odieresis /Ograve /Otilde
  111.       /Scaron
  112.       /Uacute /Ucircumflex /Udieresis /Ugrave
  113.       /Yacute /Ydieresis
  114.       /Zcaron
  115.       /aacute /acircumflex /adieresis /agrave /aring /atilde
  116.       /ccedilla
  117.       /eacute /ecircumflex /edieresis /egrave
  118.       /iacute /icircumflex /idieresis /igrave
  119.       /ntilde
  120.       /oacute /ocircumflex /odieresis /ograve /otilde
  121.       /scaron
  122.       /uacute /ucircumflex /udieresis /ugrave
  123.       /yacute /ydieresis
  124.       /zcaron
  125.     ]
  126.     { dup dup length string cvs
  127.       [ exch dup 0 1 getinterval
  128.         exch dup length 1 sub 1 exch getinterval
  129.       ]
  130.     } forall
  131.      /cent [/c /slash]
  132.      /sterling [/L /hyphen]
  133.      /yen [/Y /equal]
  134.      /daggerdbl [/bar /equal]
  135.    dicttomark /accentedchars exch def
  136.  
  137. % Load the utility procedures.
  138.    (fcutils.ps) run
  139.  
  140. % Define the Type 1 opcodes we care about.
  141.    /c_callsubr 10 def   /s_callsubr <0a> def
  142.    /c_return 11 def
  143.    /c_escape 12 def
  144.      /ce_seac 6 def   /s_seac <0c06> def
  145.      /ce_sbw 7 def   /s_sbw <0c07> def
  146.      /ce_setcurrentpoint 33 def   /s_setcurrentpoint <0c21> def
  147.    /c_hsbw 13 def   /s_hsbw <0d> def
  148.    /c_endchar 14 def   /s_endchar <0e> def
  149.    /c_hmoveto 22 def
  150.      /s_setcurrentpoint_hmoveto s_setcurrentpoint <8b16> concatstrings def
  151.  
  152. % ------ BDF file parsing utilities ------ %
  153.  
  154. % Define a buffer for reading the BDF file.
  155.    /buffer 400 string def
  156.  
  157. % Read a line from the BDF file into the buffer.
  158. % Define /keyword as the first word on the line.
  159. % Define /args as the remainder of the line.
  160. % If the keyword is equal to commentword, skip the line.
  161. % (If commentword is equal to a space, never skip.)
  162.    /commentword ( ) def
  163.    /nextline
  164.     { bdfile buffer readline not
  165.        { (Premature EOF\n) print stop } if
  166.       ( ) search
  167.        { /keyword exch def pop }
  168.        { /keyword exch def () }
  169.       ifelse
  170.       /args exch def
  171.       keyword commentword eq { nextline } if
  172.     } bind def
  173.  
  174. % Get an integer argument from args.
  175.    /iarg        % iarg -> int
  176.     { args ( ) search
  177.        { cvi exch pop exch }
  178.        { cvi () }
  179.       ifelse  /args exch def
  180.     } bind def
  181.  
  182. % Convert the remainder of args into a string.
  183.    /remarg        % remarg -> string
  184.     { args copystring
  185.     } bind def
  186.  
  187. % Get a string argument that occupies the remainder of args.
  188.    /sarg        % sarg -> string
  189.     { args (") anchorsearch
  190.        { pop /args exch def } { pop } ifelse
  191.       args args length 1 sub get (") 0 get eq
  192.        { args 0 args length 1 sub getinterval /args exch def } if
  193.       args copystring
  194.     } bind def
  195.  
  196. % Check that the keyword is the expected one.
  197.    /checkline        % (EXPECTED-KEYWORD) checkline ->
  198.     { dup keyword ne
  199.        { (Expected ) print =
  200.          (Line=) print keyword print ( ) print args print (\n) print stop
  201.        } if
  202.       pop
  203.     } bind def
  204.  
  205. % Read a line and check its keyword.
  206.    /getline        % (EXPECTED-KEYWORD) getline ->
  207.     { nextline checkline
  208.     } bind def
  209.  
  210. % Find the first/last non-zero bit of a non-zero byte.
  211.    /fnzb
  212.     { 0 { exch dup 128 ge { pop exit } { dup add exch 1 add } ifelse }
  213.       loop
  214.     } bind def
  215.    /lnzb
  216.     { 7 { exch dup 1 and 0 ne { pop exit } { -1 bitshift exch 1 sub } ifelse }
  217.       loop
  218.     } bind def
  219.  
  220. % ------ Bitmap analysis utilities ------ %
  221.  
  222. % Find the first and last bit of a row of bits.
  223. % Arguments: (cbits) (craster) y.
  224. % Result: lastbit firstbit.
  225.    /findends
  226.     { craster mul cbits exch craster getinterval /row exch def
  227.       0 row length 1 sub -1 0
  228.        { dup row exch get 0 ne
  229.           { exch pop dup row exch get lnzb exch 8 mul add exit }
  230.       { pop } ifelse
  231.        } for
  232.       row length 8 mul 0 1 row length 1 sub
  233.        { dup row exch get 0 ne
  234.           { exch pop dup row exch get fnzb exch 8 mul add exit }
  235.       { pop } ifelse
  236.        } for
  237.     } bind def 
  238.  
  239. % Determine the slant of a bitmap.
  240. % Arguments: cbits craster.
  241. % Result: dx dy of slant.
  242.    /findslant
  243.     { /craster exch def /cbits exch def
  244.       cbits length craster idiv /height exch def
  245.       % Find the width in the middle of the character.
  246.       height 2 idiv dup /top exch def dup /bot exch def
  247.       findends sub /midw exch def
  248.       % Find the top and bottom of the uniform part.
  249.        { top 0 eq { exit } if
  250.          top 1 sub findends sub midw sub
  251.      dup -1 lt { pop exit } if 1 gt { exit } if
  252.      top 1 sub /top exch def
  253.        } loop
  254.        { bot 1 add height eq { exit } if
  255.          bot 1 add findends sub midw sub
  256.      dup -1 lt { pop exit } if 1 gt { exit } if
  257.      bot 1 add /bot exch def
  258.        } loop
  259.       % Report the slant.
  260.       top findends add 2 idiv
  261.       bot findends add 2 idiv sub
  262.       bot top sub
  263.     } bind def
  264.  
  265. % ------ Type 1 encoding utilities ------ %
  266.  
  267. % Parse the side bearing and width information that begins a CharString.
  268. % Arguments: charstring.  Result: mark sbx wx substring *or*
  269. % mark sbx sby wx wy substring.
  270.    /parsesbw
  271.     { mark exch lenIV
  272.        {        % stack: mark ... string dropcount
  273.          dup 2 index length exch sub getinterval
  274.      dup 0 get dup 32 lt { pop exit } if
  275.      dup 246 le
  276.       { 139 sub exch 1 }
  277.       { dup 250 le
  278.          { 247 sub 8 bitshift 108 add 1 index 1 get add exch 2 }
  279.          { dup 254 le
  280.             { 251 sub 8 bitshift 108 add 1 index 1 get add neg exch 2 }
  281.         { pop dup 1 get 128 xor 128 sub
  282.           8 bitshift 1 index 2 get add
  283.           8 bitshift 1 index 3 get add
  284.           8 bitshift 1 index 4 get add exch 5
  285.         } ifelse
  286.          } ifelse
  287.       } ifelse
  288.        } loop
  289.     } bind def 
  290.  
  291. % Find the side bearing and width information that begins a CharString.
  292. % Arguments: charstring.  Result: charstring sizethroughsbw.
  293.    /findsbw
  294.     { dup parsesbw counttomark 1 add 1 roll cleartomark skipsbw
  295.     } bind def
  296.    /skipsbw        % charstring sbwprefix -> sizethroughsbw
  297.     { length 1 index length exch sub
  298.       2 copy get 12 eq { 2 } { 1 } ifelse add
  299.     } bind def
  300.  
  301. % Encode a number, and append it to a string.
  302. % Arguments: str num.  Result: newstr.
  303.    /concatnum
  304.     { dup dup -107 ge exch 107 le and
  305.        { 139 add 1 string dup 0 3 index put }
  306.        { dup dup -1131 ge exch 1131 le and
  307.           { dup 0 ge { 16#f694 } { neg 16#fa94 } ifelse add
  308.         2 string dup 0 3 index -8 bitshift put
  309.         dup 1 3 index 255 and put
  310.       }
  311.       { 5 string dup 0 255 put exch
  312.         2 copy 1 exch -24 bitshift 255 and put
  313.         2 copy 2 exch -16 bitshift 255 and put
  314.         2 copy 3 exch -8 bitshift 255 and put
  315.         2 copy 4 exch 255 and put
  316.         exch
  317.       }
  318.      ifelse
  319.        }
  320.       ifelse exch pop concatstrings
  321.     } bind def
  322.  
  323. % Encode a subroutine call for a given character, appending it to a string.
  324. % Arguments: str subrindex.  Result: newstr.
  325.    /concatcall
  326.     { () exch concatnum
  327.       s_callsubr concatstrings concatstrings
  328.     } bind def
  329.  
  330. % ------ Point arithmetic utilities ------ %
  331.  
  332.    /ptadd { exch 4 -1 roll add 3 1 roll add } bind def
  333.  
  334.    /ptexch { 4 2 roll } bind def
  335.  
  336.    /ptneg { neg exch neg exch } bind def
  337.  
  338.    /ptsub { ptneg ptadd } bind def
  339.  
  340. % ------ Output utilities ------ %
  341.  
  342. % Define some utilities for writing the output file.
  343.    /wtstring 100 string def
  344.    /ws {psfile exch writestring} bind def
  345.    /wl {ws (\n) ws} bind def
  346.    /wt {wtstring cvs ws ( ) ws} bind def
  347.    /wo {psfile exch write==only ( ) ws} bind def
  348.  
  349. % Encrypt and write a hex string for Subrs or CharStrings.
  350. % Note that this smashes the string being written.
  351.    /wx
  352.     { 4330 exch dup type1encrypt exch pop
  353.       (_R ) ws dup length wt
  354.       binary
  355.        { ws
  356.        }
  357.        { % Some systems choke on very long lines, so
  358.      % we break up the hexstring into chunks of 50 characters.
  359.       { dup length 25 le {exit} if
  360.         dup 0 25 getinterval psfile exch writehexstring (\n) ws
  361.         dup length 25 sub 25 exch getinterval
  362.       } loop
  363.      psfile exch writehexstring
  364.        } ifelse
  365.     } bind def
  366. % Write a character definition.
  367.    /wcdef
  368.     { (/) ws exch ws ( ) ws wx ( _D) wl
  369.     } bind def
  370.  
  371. % ------ The main program ------ %
  372.  
  373.    /bdftops        % infilename outfilename mapfilename bdftops ->
  374.     { /mapname exch def
  375.       /psname exch def
  376.       /bdfname exch def
  377.       gsave        % so we can set the CTM to the font matrix
  378.  
  379. %  Open the input files.  We don't open the output file until
  380. %  we've done a minimal validity check on the input.
  381.       bdfname (r) file /bdfile exch def
  382.       mapname findlibfile not
  383.         { (bdftops: Can't find map file ) print print (!\n) print stop }
  384.       if
  385.       /mapfile exch def
  386.  
  387. %  Check for the STARTFONT.
  388.       (STARTFONT) getline
  389.       args (2.1) ne { (Not version 2.1\n) print stop } if
  390.  
  391. %  Look up the output file name in the font map.
  392.       mapfile psname fontmapfind
  393.       /uniqueID exch def
  394.       /encoding exch def
  395.       /fontname exch def
  396.  
  397. %  Now open the output file.
  398.       psname (w) file /psfile exch def
  399.  
  400. %  Put out a header compatible with the Adobe "standard".
  401.       (%!FontType1-1.0: ) ws fontname wt (000.000) wl
  402.  
  403. %  Copy the leading comments, up to FONT.
  404.       (% This is a font description converted from ) ws
  405.         bdfname ws (.) wl
  406.       true
  407.       { nextline
  408.         keyword (COMMENT) ne {exit} if
  409.     { (% Here are the leading comments from the BDF file:\n%) wl
  410.     } if false
  411.     (%) ws remarg wl
  412.       } loop pop
  413.       /commentword (COMMENT) def    % do skip comments from now on
  414.  
  415. %  Read and process the FONT, SIZE, and FONTBOUNDINGBOX.
  416.       % If we cared about FONT, we'd use it here.  If the BDF files
  417.       % from MIT had PostScript names rather than X names, we would
  418.       % care; but what's there is unusable, so we discard FONT.
  419.       (FONT) checkline
  420.       (SIZE) getline
  421.         /pointsize iarg def   /xres iarg def   /yres iarg def
  422.       (FONTBOUNDINGBOX) getline
  423.         /fbbw iarg def   /fbbh iarg def   /fbbxo iarg def   /fbbyo iarg def
  424.     /fraster fbbw 7 add 8 idiv def
  425.       nextline
  426.  
  427. % Allocate the buffers for the bitmap and the outline,
  428. % according to the font bounding box.
  429.       /bits fraster fbbh mul 200 max 65535 min string def
  430.       /outline bits length 6 mul 65535 min string def
  431.       /iangles 0 def  /iacount 0 def
  432.  
  433. %  The Type 1 font machinery really only works with a 1000 unit
  434. %  character coordinate system.  Set this up here.
  435.     % Compute the factor to make the X entry in the FontMatrix
  436.     % come out at exactly 0.001.
  437.     /fontscale   72 pointsize div xres div 1000 mul   def
  438.  
  439. %  Read and process the properties.  We only care about a few of them.
  440.       /pcount 0 def
  441.       keyword (STARTPROPERTIES) eq
  442.        { iarg
  443.           { nextline
  444.         keyword (COPYRIGHT) eq
  445.         keyword (FULL_NAME) eq or
  446.         keyword (FAMILY_NAME) eq or
  447.         keyword (WEIGHT_NAME) eq or
  448.          { keyword cvn sarg def
  449.            /pcount pcount 1 add def
  450.          } if
  451.       } repeat
  452.          (ENDPROPERTIES) getline
  453.      nextline
  454.        } if
  455.  
  456. %  Compute and set the eventual FontMatrix.
  457.       [ 0.001 0 0 0.001 xres mul yres div 0 0 ] setmatrix
  458.  
  459. %  Read and process the header for the bitmaps.
  460.       (CHARS) checkline
  461.         /ccount iarg def
  462.  
  463. %  Initialize the character subroutine table and the CharStrings dictionary.
  464.       /subrs subrchars length array def
  465.       /subrsbw subrchars length array def
  466.       /subrcount 0 def
  467.       /charstrings ccount composites length add
  468.         accentedchars length add dict def
  469.       /isfixedwidth true def
  470.       /fixedwidth null def
  471.  
  472. %  Read and process the bitmap data.  This reads the remainder of the file.
  473.       ccount -1 1
  474.        { (STARTCHAR) getline
  475.            /charname remarg def
  476.      (/) print charname print
  477.        10 mod 1 eq { (\n) print flush } if
  478.      (ENCODING) getline        % Ignore, assume StandardEncoding
  479.      (SWIDTH) getline
  480.        /swx iarg pointsize mul 1000 div xres mul 72 div def
  481.        /swy iarg pointsize mul 1000 div xres mul 72 div def
  482.      (DWIDTH) getline        % Ignore, use SWIDTH instead
  483.      (BBX) getline
  484.        /bbw iarg def  /bbh iarg def  /bbox iarg def  /bboy iarg def
  485.      nextline
  486.      keyword (ATTRIBUTES) eq
  487.       { nextline
  488.       } if
  489.      (BITMAP) checkline
  490.  
  491. %  Read the bits for this character.
  492.      bbw 7 add 8 idiv /raster exch def
  493. % The bitmap handed to type1imagepath must have the correct height,
  494. % because type1imagepath uses this to compute the scale factor,
  495. % so we have to clear the unused parts of it.
  496.      bits dup 0 1 raster fbbh mul 1 sub
  497.       { 0 put dup } for
  498.      pop pop
  499.      raster fbbh bbh sub mul   raster   raster fbbh 1 sub mul
  500.       { bits exch raster getinterval
  501.         bdfile buffer readline not
  502.          { (EOF in bitmap\n) print stop } if
  503.         exch readhexstring pop pop pop
  504.       } for
  505.      (ENDCHAR) getline
  506.  
  507. %  Compute the font entry, converting the bitmap to an outline.
  508.      bits 0 raster fbbh mul getinterval    % the bitmap image
  509.      bbw   fbbh                % bitmap width & height
  510.      swx   swy                % width x & y
  511.      bbox neg   bboy neg            % origin x & y
  512.          % Account for lenIV when converting the outline.
  513.      outline  lenIV  outline length lenIV sub  getinterval
  514.      type1imagepath
  515.      length lenIV add
  516.      outline exch 0 exch getinterval
  517.  
  518. % Check for a fixed width font.
  519.      isfixedwidth
  520.       { fixedwidth null eq
  521.          { /fixedwidth swx def }
  522.          { fixedwidth swx ne { /isfixedwidth false def } if }
  523.         ifelse
  524.       } if
  525.  
  526. % Use this character to determine italic angle if plausible.
  527.      charname (I) eq charname (l) eq or
  528.       { bits 0 raster fbbh mul getinterval raster findslant
  529.         2 copy or 0 ne
  530.          { atan iangles add /iangles exch def
  531.            iacount 1 add /iacount exch def
  532.          }
  533.          { pop pop
  534.          } ifelse
  535.       } if
  536.  
  537. % Check whether this character must be a subroutine.
  538. % If so, strip off the initial [h]sbw, replace the endchar by a return,
  539. % and put the charstring in the Subrs array.
  540.      subrchars charname known
  541.       { /charstr exch def
  542.         /csindex subrchars charname get def
  543.         charstr parsesbw counttomark 1 add 1 roll
  544.           counttomark 2 eq { 0 exch 0 } if ]
  545.           subrsbw exch csindex exch put
  546.           charstr exch skipsbw /charend exch def pop
  547.         charstr charstr length 1 sub c_return put
  548.         subrs   csindex
  549.           charstr   charend lenIV sub   dup charstr length exch sub
  550.             getinterval copystring
  551.         put
  552.         charstr 0 charend getinterval
  553.           () subrchars charname get concatcall s_endchar concatstrings
  554.           concatstrings
  555.         /subrcount subrcount 1 add def
  556.       }
  557.       { copystring }
  558.      ifelse
  559.      charname exch charstrings 3 1 roll put
  560.        } for
  561.       (ENDFONT) getline
  562.  
  563. %  Synthesize missing characters out of available ones.
  564. %  For fixed-width fonts, only do this in the 1-for-1 case.
  565.       composites
  566.        { 1 index charstrings exch known
  567.           { pop pop }
  568.       { dup isfixedwidth
  569.          { dup length 1 eq }
  570.          { true }
  571.         ifelse
  572.         exch { charstrings exch known and } forall
  573.          { ( /) print 1 index bits cvs print
  574.            dup length 1 eq
  575.             { 0 get charstrings exch get copystring }
  576.         { % Top of stack is array of characters to combine.
  577.           % Convert to an array of subr indices.
  578.           [ exch { subrchars exch get } forall ]
  579.           % The final width is the sum of the widths of all
  580.           % the characters, minus the side bearings of all the
  581.           % characters except the first.  After each character
  582.           % except the last, do a setcurrentpoint of its width
  583.           % minus its side bearing (except for the first character);
  584.           % before each character except the first, do a 0 hmoveto.
  585.           % Fortunately, all this information is available in subrsbw.
  586.           /combine exch def
  587.           lenIV string
  588.           % Compute the total width.
  589.           subrsbw combine 0 get get aload pop pop pop 2 copy
  590.           combine
  591.            { subrsbw exch get
  592.              aload pop ptexch ptsub ptadd
  593.            } forall
  594.           % Encode the combined side bearing and width.
  595.           dup 3 index or 0 eq
  596.            { pop exch pop 2 array astore s_hsbw }
  597.            { 4 array astore s_sbw }
  598.           ifelse
  599.           3 1 roll { concatnum } forall exch concatstrings
  600.           % Encode the subroutine calls, except the last.
  601.           subrsbw combine 0 get get aload pop ptexch pop pop
  602.           0 1 combine length 2 sub
  603.            { combine exch get /ccsi exch def
  604.              2 copy 5 -1 roll ccsi concatcall
  605.              3 -1 roll concatnum exch concatnum
  606.              s_setcurrentpoint_hmoveto concatstrings
  607.              subrsbw ccsi get aload pop ptexch ptsub
  608.              5 -2 roll ptadd
  609.            } for
  610.           % Encode the last call.
  611.           pop pop
  612.           combine dup length 1 sub get concatcall
  613.           s_endchar concatstrings
  614.         } ifelse
  615.            charstrings 3 1 roll put
  616.          }
  617.          { pop pop }
  618.         ifelse
  619.       }
  620.      ifelse
  621.        }
  622.       forall flush
  623.  
  624. %  Synthesize accented characters with seac if needed and possible.
  625.       accentedchars
  626.        { aload pop /accent exch def /base exch def
  627.          buffer cvs /accented exch def
  628.      charstrings accented known not
  629.      charstrings base known and
  630.      charstrings accent known and
  631.       { ( /) print accented print
  632.         charstrings base get findsbw 0 exch getinterval
  633.         /acstring exch def        % start with sbw of base
  634.         charstrings accent get parsesbw
  635.         counttomark 1 sub { pop } repeat    % just leave mark & sbx
  636.         acstring exch concatnum exch pop    % pop the mark
  637.         0 concatnum 0 concatnum        % adx ady
  638.         decoding base get concatnum        % bchar
  639.         decoding accent get concatnum    % achar
  640.         s_seac concatstrings
  641.         charstrings exch accented copystring exch put
  642.       } if
  643.        } forall
  644.  
  645. %  Write out the creation of the font dictionary and FontInfo.
  646.       (12 dict begin) wl
  647.       (/FontInfo ) ws pcount 2 add wt (dict dup begin) wl
  648.       (/isFixedPitch ) ws isfixedwidth wt (def) wl
  649.       (/ItalicAngle ) ws
  650.       iacount 0 eq
  651.        { (0 ) ws }
  652.        { iangles iacount div 5 div round 5 mul cvi wt }
  653.       ifelse (def) wl
  654.       currentdict /COPYRIGHT known
  655.        { (/Notice ) ws COPYRIGHT wo (readonly def) wl } if
  656.       currentdict /FULL_NAME known
  657.        { (/FullName ) ws FULL_NAME wo (readonly def) wl } if
  658.       currentdict /FAMILY_NAME known
  659.        { (/FamilyName ) ws FAMILY_NAME wo (readonly def) wl } if
  660.       currentdict /WEIGHT_NAME known
  661.        { (/Weight ) ws WEIGHT_NAME wo (readonly def) wl } if
  662.       (end readonly def) wl
  663.  
  664. %  Write out the other fixed entries in the font dictionary.
  665.       (/FontName ) ws fontname wo (def) wl
  666.       (/PaintType 0 def) wl
  667.       (/FontType 1 def) wl
  668.       (/FontMatrix [ ) ws
  669.         matrix currentmatrix {wt} forall
  670.     (] readonly def) wl
  671.       (/Encoding ) ws encoding wt (def) wl
  672.       fontscale
  673.       (/FontBBox { ) ws
  674.     dup fbbxo mul wt   dup fbbyo mul wt
  675.     dup fbbxo fbbw add mul wt   dup fbbyo fbbh add mul wt
  676.     (} readonly def) wl
  677.       pop
  678.       (/UniqueID ) ws uniqueID wt (def) wl    % uniqueID is an integer
  679.       (currentdict end) wl
  680.  
  681. %  The rest of the file could be in eexec form, but we don't see any point
  682. %  in doing this, because we aren't attempting to conceal it from anyone.
  683.  
  684. %  Create and initialize the Private dictionary.
  685.       (dup /Private 9 dict dup begin) wl
  686.       (/_D {readonly def} readonly def) wl
  687.       (/_P {readonly put} _D) wl
  688.       (/_R {currentfile token pop string currentfile exch ) ws
  689.         binary {(readstring)} {(readhexstring)} ifelse ws
  690.         ( pop} _D) wl
  691.       (/BlueValues [] def) wl
  692.       (/lenIV ) ws lenIV wt (def) wl
  693.       (/MinFeature {16 16} def) wl
  694.       (/password 5839 def) wl
  695.       (/UniqueID ) ws uniqueID wt (def) wl
  696.  
  697. %  Write the Subrs entries, if any.
  698.       subrcount 0 gt
  699.        { (/Subrs ) ws subrs length wt (array) wl
  700.          0 1 subrs length 1 sub
  701.       { dup subrs exch get dup null ne
  702.          { (dup ) ws exch wo wx ( _P) wl }
  703.          { pop pop }
  704.         ifelse
  705.       } for
  706.          (_D) wl
  707.        }
  708.       if
  709.  
  710. %  Write all the CharStrings entries.
  711.       (2 index /CharStrings ) ws charstrings length 1 add wt
  712.         (dict dup begin) wl
  713.       charstrings { wcdef } forall
  714.  
  715. %  Write the CharStrings entry for .notdef.
  716.       outline lenIV <8b8b0d0e> putinterval    % 0 0 hsbw endchar
  717.       (.notdef) outline 0 lenIV 4 add getinterval wcdef
  718.  
  719. %  Wrap up the private part of the font.
  720.       (end) wl        % CharStrings
  721.       (end) wl        % Private
  722.       (readonly put) wl        % CharStrings
  723.       (readonly put) wl        % Private
  724.  
  725. %  Write the other standard entries in the font dictionary.
  726.       (dup begin) wl
  727.       (end) wl
  728.  
  729. %  Terminate the output, and close the files.
  730.       (dup /FontName get exch definefont pop) wl
  731.       bdfile closefile
  732.       psfile closefile
  733.       (\n) print flush
  734.       grestore
  735.     } bind def
  736. end
  737.  
  738. % Enter the main program in the current dictionary.
  739. /bdftops
  740.  { envBDF begin   (Fontmap) bdftops end
  741.  } bind def
  742.  
  743. % If the program was invoked from the command line, run it now.
  744. shellarguments { bdftops } if
  745.